Ham Radio 2000 #1/Ham Radio 2000.iso/ham2000/packet/terminal/gp161b/conv.pas

Pascal/Delphi Source File | 1993-10-05 | 8.4 KB | 376 lines

{$M 1024,0,0}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V+,X+}

PROGRAM Conv;   { Convers für GP }


USES Dos,GPRI;

CONST
  LineLength           = 78;
  GPConvers            = 0;
  Version              = '1.01';
  OK                   = '#OK#';
  CR                   = #13;
  SendConversMessage   = 0;
  GetAllConversUsers   = 1;
  GetChannelUsers      = 2;
  SendPrivateMessage   = 3;
  HelpStr1             = #13'*** convers help:'#13+
                            ' /CHannel <n>   or'#13+
                            ' /<n>           switch to channel <n>'#13+
                            ' /Disconnect    disconnects the qso'#13+
                            ' /Help          This text'#13;

  HelpStr2             =    ' /MSG <call>    Sends a private msg to <call>'#13+
                            ' /Quit          Terminates the convers session'#13+
                            ' /Who           List of all logged in stations'#13+
                            '***'#13#13;


TYPE
  Str10         = String[10];
  ConversData   = RECORD
                    FNr,
                    Chan   : Word;
                    Data   : String;
                    ToCall : Str10;
                  END;



VAR
  ConversKanal    : Word;
  QSOData         : QSODataType;
  RightVersion    : Boolean;



PROCEDURE Parse (VAR S : String; Sysop : Boolean); Forward;



FUNCTION FormatString (Header : Str10; S : String) : String;

VAR
  P  : Byte;

BEGIN
  S := Concat(Header,S);
  IF Byte(S[0]) > LineLength THEN BEGIN
    P := LineLength;
    WHILE (P > 0) AND (String(S)[P] <> ' ') DO Dec(P);
    IF P > 0 THEN BEGIN
      Delete(String(S),P,1);
      Insert(#13+Header,String(S),P);
    END;
  END;
  FormatString := S;
END;



PROCEDURE UpdateUserList (VAR D : ConversData);

VAR
  S   : Str10;

BEGIN
  Str(ConversKanal:6,S);
  WITH D DO
    IF (FNr = GetAllConversUsers) OR (Chan = ConversKanal) THEN
      Data := Concat(Data,S,':',QSOData.Call,CR);
END;



PROCEDURE SysopMessage (VAR S : String); far;

VAR
  D   : ConversData;

BEGIN
  IF S[1] = '/' THEN
    Parse(S,TRUE)
  ELSE BEGIN
    WITH D DO BEGIN
      Data := FormatString('-'+QSOData.MyCall+'-:',S);
      Chan := ConversKanal;
      FNr := SendConversMessage;
    END;
    SendGPRIMessage(GPConvers,D);
    SendString(D.Data);
  END;
  S := '';
END;


PROCEDURE GetPrivateMsg (VAR D : ConversData);

BEGIN
  WITH D DO
    IF ToCall = QSOData.Call THEN BEGIN
      SendString(Data);
      ToCall := OK;
    END;
END;



PROCEDURE GetConversMessage (Ident : Word; VAR D : ConversData); far;

BEGIN
  IF Ident = GPConvers THEN WITH D DO BEGIN
    CASE FNr OF
      SendConversMessage : IF Chan = ConversKanal THEN SendString(Data);
      GetAllConversUsers : UpdateUserList(D);
      GetChannelUsers    : UpdateUserList(D);
      SendPrivateMessage : GetPrivateMsg(D);
    END;
  END;
END;



PROCEDURE UserListe (Mode : Word);

VAR
  D   : ConversData;
  S   : Str10;

BEGIN
  Str(ConversKanal:6,S);
  WITH D DO BEGIN
    Data := Concat('*** convers users:'#13,S,':',QSOData.MyCall,' (SysOp)',CR);
    Chan := ConversKanal;
    FNr := Mode;
  END;
  UpdateUserList(D);
  SendGPRIMessage(GPConvers,D);
  SendString(D.Data);
  SendString('***'#13#13);
END;



PROCEDURE Login (Chan : Word);

VAR
  D  : ConversData;
  S  : Str10;

BEGIN
  Str(Chan,S);
  IF Chan <> ConversKanal THEN BEGIN
    WITH D DO BEGIN
      FNr := SendConversMessage;
      Data := Concat('-',QSOData.Call,'- *** switched to channel ',S,CR);
      Chan := ConversKanal;
    END;
    SendGPRIMessage(GPConvers,D);
    SendString('*** now on channel '+S+CR);
  END;
  ConversKanal := Chan;
  WITH D DO BEGIN
    FNr := SendConversMessage;
    Data := Concat('-',QSOData.Call,'- *** login',CR);
    Chan := ConversKanal;
  END;
  SendGPRIMessage(GPConvers,D);
  UserListe(GetChannelUsers);
END;



PROCEDURE GrossSchrift (VAR S);

VAR
  L : Byte;

BEGIN
  FOR L := 1 TO Byte(S) DO String(S)[L] := UpCase(String(S)[L]);
END;



FUNCTION BefehlErkannt (Befehl,S : String; Min : Byte) : Boolean;

VAR
  I,N      : Byte;
  Gefunden : Boolean;

BEGIN
  GrossSchrift(S);
  Gefunden := FALSE;
  I := Min;
  WHILE (I <= Byte(Befehl[0])) AND NOT Gefunden DO BEGIN
    Gefunden := (Pos(Copy(Befehl,1,I)+' ',S) = 1) OR (Pos(Copy(Befehl,1,I)+CR,S) = 1);
    Inc(I);
  END;
  BefehlErkannt := Gefunden;
END;




PROCEDURE Parse (VAR S : String; Sysop : Boolean);

VAR
  Dummy,
  Fehler   : Integer;
  D        : ConversData;

BEGIN
  IF (Byte(S[0]) > 0) AND (S[1] = '/') THEN BEGIN
    Delete(S,1,1);
    IF BefehlErkannt('HELP',S,1) THEN BEGIN
      SendString(HelpStr1);
      SendString(HelpStr2);
      Exit;
    END;
    IF BefehlErkannt('WHO',S,1) THEN BEGIN
      UserListe(GetAllConversUsers);
      Exit;
    END;
    IF BefehlErkannt('QUIT',S,1) THEN BEGIN
      SendString(#13'*** convers session terminated. 73...'#13);
      ProgrammEnde := TRUE;
      Exit;
    END;
    IF BefehlErkannt('DISCONNECT',S,1) THEN BEGIN
      SendString(#13'*** convers session terminated. 73...'#13);
      DisconnectChannel;
      Exit;
    END;
    IF BefehlErkannt('CHANNEL',S,2) THEN BEGIN
      Dummy := Pos(' ',S);
      IF Dummy > 0 THEN BEGIN
        Delete(S,1,Dummy);
        Val(Copy(S,1,Byte(S[0])-1),Dummy,Fehler);
        IF (Fehler = 0) THEN BEGIN
          IF Dummy <> ConversKanal THEN
            Login(Dummy)
          ELSE
            SendString('*** already on channel '+S);
        END ELSE
          SendString('*** invalid channel number'#13);
      END ELSE
        SendString('*** argument required.'#13);
      Exit;
    END;
    IF BefehlErkannt('MSG',S,1) THEN BEGIN
      Dummy := Pos(' ',S);
      IF Dummy > 0 THEN BEGIN
        Delete(S,1,Dummy);
        WHILE (S[0] > #0) AND (S[1] = ' ') DO Delete(S,1,1);
        Dummy := Pos(' ',S);
        IF Dummy > 0 THEN BEGIN
          D.ToCall := Copy(S,1,Dummy-1);
          GrossSchrift(D.ToCall);
          WHILE (S[0] > #0) AND (S[1] = ' ') DO Delete(S,1,1);
          IF Sysop THEN
            D.Data := FormatString('*'+QSOData.MyCall+'*:',Copy(S,Dummy+1,Byte(S[0])))
          ELSE
            D.Data := FormatString('*'+QSOData.Call+'*:',Copy(S,Dummy+1,Byte(S[0])));
          D.FNr := SendPrivateMessage;
          D.Chan := 0;
          SendGPRIMessage(GPConvers,D);
          IF D.ToCall <> OK THEN
            SendString('*** station not connected.'#13);
        END ELSE
          SendString('*** where''s the text???'#13);
      END ELSE
        SendString('*** argument required.'#13);
      Exit;
    END;
    SendString(#13'*** unknown convers command.'#13#13);
  END;
END;





PROCEDURE RX (VAR S : String); far;

VAR
  D   : ConversData;

BEGIN
  IF S[1] = '/' THEN
    Parse(S,FALSE)
  ELSE BEGIN
    WITH D DO BEGIN
      FNr := SendConversMessage;
      Data := FormatString('-'+QSOData.Call+'-:',S);
      Chan := ConversKanal;
    END;
    SendGPRIMessage(GPConvers,D);
  END;
END;



PROCEDURE Init; far;

VAR
  S   : String;
  D   : ConversData;
  P   : Byte;
  F   : Integer;

BEGIN
  IF NOT RightVersion THEN BEGIN
    S := CR+'*** GPRI Version 1.1 required.'+CR+CR;
    ProgrammEnde := TRUE;
    SendString(S);
    Exit;
  END ELSE
    S := #13'*** GP-Convers Revision '+Version+'  (C) Ulf Saran, DH1DAE 1993'#13+
            '*** Type /H for help'#13#13;
  SendString(S);
  IF ParamCount > 0 THEN BEGIN
    Val(ParamStr(1),ConversKanal,F);
    IF F > 0 THEN BEGIN
      SendString('*** invalid channel number.'#13);
      ConversKanal := 0;
    END;
  END ELSE
    ConversKanal := 0;
  GetQSOData(QSOData);
  WITH QSOData DO BEGIN
    P := Pos('-',Call);
    IF P > 0 THEN Delete(Call,P,3);  { SSID weglassen }
    P := Pos('-',MyCall);
    IF P > 0 THEN Delete(MyCall,P,3);  { SSID weglassen }
  END;
  Login(ConversKanal);
END;



PROCEDURE Ende; far;

VAR
  D  : ConversData;

BEGIN
  WITH D DO BEGIN
    Data := Concat('-',QSOData.Call,'- *** logout'#13);
    FNr := SendConversMessage;
    Chan := ConversKanal;
  END;
  SendGPRIMessage(GPConvers,D);
END;



BEGIN
  RightVersion := InstallTXHandler(@SysopMessage) AND
                  InstallGPRIMessageHandler(@GetConversMessage);
  IF NOT TaskInit(@Init,@RX,NIL,@Ende) THEN BEGIN
    Writeln('Kein GPRI-Host gefunden, Programm kann nicht gestartet werden.');
    Halt;
  END;
  Keep(0);
END.